home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / abrows1a / frmabout.frm (.txt) < prev    next >
Visual Basic Form  |  1999-07-24  |  10KB  |  229 lines
  1. VERSION 5.00
  2. Begin VB.Form frmAbout 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "Andrew's Web Browser : About"
  5.    ClientHeight    =   3630
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   5865
  9.    ClipControls    =   0   'False
  10.    BeginProperty Font 
  11.       Name            =   "Comic Sans MS"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   400
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    LinkTopic       =   "Form1"
  20.    MaxButton       =   0   'False
  21.    MinButton       =   0   'False
  22.    Picture         =   "frmAbout.frx":0000
  23.    ScaleHeight     =   3630
  24.    ScaleWidth      =   5865
  25.    ShowInTaskbar   =   0   'False
  26.    StartUpPosition =   1  'CenterOwner
  27.    Tag             =   "About Project1"
  28.    Begin VB.CommandButton cmdOK 
  29.       Cancel          =   -1  'True
  30.       Caption         =   "OK"
  31.       Default         =   -1  'True
  32.       BeginProperty Font 
  33.          Name            =   "MS Sans Serif"
  34.          Size            =   8.25
  35.          Charset         =   0
  36.          Weight          =   400
  37.          Underline       =   0   'False
  38.          Italic          =   0   'False
  39.          Strikethrough   =   0   'False
  40.       EndProperty
  41.       Height          =   345
  42.       Left            =   4245
  43.       TabIndex        =   0
  44.       Tag             =   "OK"
  45.       Top             =   2625
  46.       Width           =   1467
  47.    End
  48.    Begin VB.CommandButton cmdSysInfo 
  49.       Caption         =   "&System Info..."
  50.       BeginProperty Font 
  51.          Name            =   "MS Sans Serif"
  52.          Size            =   8.25
  53.          Charset         =   0
  54.          Weight          =   400
  55.          Underline       =   0   'False
  56.          Italic          =   0   'False
  57.          Strikethrough   =   0   'False
  58.       EndProperty
  59.       Height          =   345
  60.       Left            =   4260
  61.       TabIndex        =   1
  62.       Tag             =   "&System Info..."
  63.       Top             =   3075
  64.       Width           =   1452
  65.    End
  66.    Begin VB.Label lblDescription 
  67.       Caption         =   $"frmAbout.frx":20EA
  68.       ForeColor       =   &H00000000&
  69.       Height          =   1170
  70.       Left            =   1050
  71.       TabIndex        =   5
  72.       Tag             =   "App Description"
  73.       Top             =   1080
  74.       Width           =   4095
  75.    End
  76.    Begin VB.Label lblTitle 
  77.       Caption         =   "Andrew's Web Browser"
  78.       ForeColor       =   &H00000000&
  79.       Height          =   480
  80.       Left            =   1050
  81.       TabIndex        =   4
  82.       Tag             =   "Application Title"
  83.       Top             =   240
  84.       Width           =   4092
  85.    End
  86.    Begin VB.Line Line1 
  87.       BorderColor     =   &H00808080&
  88.       BorderStyle     =   6  'Inside Solid
  89.       Index           =   1
  90.       X1              =   225
  91.       X2              =   5657
  92.       Y1              =   2430
  93.       Y2              =   2430
  94.    End
  95.    Begin VB.Line Line1 
  96.       BorderColor     =   &H00FFFFFF&
  97.       BorderWidth     =   2
  98.       Index           =   0
  99.       X1              =   240
  100.       X2              =   5657
  101.       Y1              =   2445
  102.       Y2              =   2445
  103.    End
  104.    Begin VB.Label lblVersion 
  105.       Caption         =   "Version : 1.2"
  106.       Height          =   225
  107.       Left            =   1050
  108.       TabIndex        =   3
  109.       Tag             =   "Version"
  110.       Top             =   780
  111.       Width           =   4092
  112.    End
  113.    Begin VB.Label lblDisclaimer 
  114.       Caption         =   "Warning: ... Not to use this browser may increase your grey hair count!"
  115.       ForeColor       =   &H00000000&
  116.       Height          =   825
  117.       Left            =   255
  118.       TabIndex        =   2
  119.       Tag             =   "Warning: ..."
  120.       Top             =   2625
  121.       Width           =   3870
  122.    End
  123. Attribute VB_Name = "frmAbout"
  124. Attribute VB_GlobalNameSpace = False
  125. Attribute VB_Creatable = False
  126. Attribute VB_PredeclaredId = True
  127. Attribute VB_Exposed = False
  128. ' Reg Key Security Options...
  129. Const KEY_ALL_ACCESS = &H2003F
  130.                                           
  131. ' Reg Key ROOT Types...
  132. Const HKEY_LOCAL_MACHINE = &H80000002
  133. Const ERROR_SUCCESS = 0
  134. Const REG_SZ = 1                         ' Unicode nul terminated string
  135. Const REG_DWORD = 4                      ' 32-bit number
  136. Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
  137. Const gREGVALSYSINFOLOC = "MSINFO"
  138. Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
  139. Const gREGVALSYSINFO = "PATH"
  140. Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
  141. Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
  142. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  143. Private Sub Form_Load()
  144.     lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
  145.     lblTitle.Caption = App.Title
  146. End Sub
  147. Private Sub cmdSysInfo_Click()
  148.         Call StartSysInfo
  149. End Sub
  150. Private Sub cmdOK_Click()
  151.         Unload Me
  152. End Sub
  153. Public Sub StartSysInfo()
  154.     On Error GoTo SysInfoErr
  155.         Dim rc As Long
  156.         Dim SysInfoPath As String
  157.         
  158.         ' Try To Get System Info Program Path\Name From Registry...
  159.         If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  160.         ' Try To Get System Info Program Path Only From Registry...
  161.         ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  162.                 ' Validate Existance Of Known 32 Bit File Version
  163.                 If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
  164.                         SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
  165.                         
  166.                 ' Error - File Can Not Be Found...
  167.                 Else
  168.                         GoTo SysInfoErr
  169.                 End If
  170.         ' Error - Registry Entry Can Not Be Found...
  171.         Else
  172.                 GoTo SysInfoErr
  173.         End If
  174.         
  175.         Call Shell(SysInfoPath, vbNormalFocus)
  176.         
  177.         Exit Sub
  178. SysInfoErr:
  179.         MsgBox "System Information Is Unavailable At This Time", vbOKOnly
  180. End Sub
  181. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  182.         Dim i As Long                                           ' Loop Counter
  183.         Dim rc As Long                                          ' Return Code
  184.         Dim hKey As Long                                        ' Handle To An Open Registry Key
  185.         Dim hDepth As Long                                      '
  186.         Dim KeyValType As Long                                  ' Data Type Of A Registry Key
  187.         Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
  188.         Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
  189.         '------------------------------------------------------------
  190.         ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
  191.         '------------------------------------------------------------
  192.         rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
  193.         
  194.         If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
  195.         
  196.         tmpVal = String$(1024, 0)                             ' Allocate Variable Space
  197.         KeyValSize = 1024                                       ' Mark Variable Size
  198.         
  199.         '------------------------------------------------------------
  200.         ' Retrieve Registry Key Value...
  201.         '------------------------------------------------------------
  202.         rc = RegQueryValueEx(hKey, SubKeyRef, 0, KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
  203.                                                 
  204.         If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
  205.         
  206.         tmp